home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / hipsquar / HOURGLAS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-06-07  |  4.1 KB  |  150 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {     Creating Non-Rectangular Windows                    }
  4. {                                                         }
  5. {     Requires Win32 API (Delphi 2.0 or 3.0 or newer)     }
  6. {                                                         }
  7. {     Copyright ⌐ 1997 Steven J. Colagiovanni             }
  8. {                                                         }
  9. {*********************************************************}
  10.  
  11. unit Hourglas;
  12.  
  13. interface
  14.  
  15. uses
  16.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17.   ExtCtrls;
  18.  
  19. type
  20.   TfrmHourGlass = class(TForm)
  21.     procedure FormCreate(Sender: TObject);
  22.         procedure FormKeyDown(Sender: TObject; var Key: Word;
  23.             Shift: TShiftState);
  24.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  25.       Shift: TShiftState; X, Y: Integer);
  26.     procedure FormPaint(Sender: TObject);
  27.     private
  28.         { Private declarations }
  29.         procedure CalcRgnPoints;
  30.     public
  31.         { Public declarations }
  32.     end;
  33.  
  34. var
  35.     frmHourGlass: TfrmHourGlass;
  36.  
  37. implementation
  38.  
  39. {$R *.DFM}
  40.  
  41. var
  42.     RgnPts: array[0..17] of TPoint;
  43.     ScnPts: array[0..13] of TPoint;
  44.  
  45. const
  46.     nPts: byte = 18;
  47.  
  48. procedure TfrmHourGlass.CalcRgnPoints;
  49. var
  50.     TitleHeight: Integer;
  51.  
  52. begin
  53.     { Get height of title bar }
  54.     TitleHeight := GetSystemMetrics(SM_CYCAPTION) +
  55.         GetSystemMetrics(SM_CYDLGFRAME) + 1;
  56.  
  57.     {Set width and height of form }
  58.     Width := 130;
  59.     Height := 240 + (TitleHeight * 2);
  60.  
  61.     { Window region (borders) }
  62.     RgnPts[0] := Point(0, 0);
  63.     RgnPts[1] := Point(Width, 0);
  64.     RgnPts[2] := Point(Width, TitleHeight);
  65.     RgnPts[3] := Point(Width - 5, TitleHeight);
  66.     RgnPts[4] := Point(Width - 5, TitleHeight + 60);
  67.     RgnPts[5] := Point(Width - 60, TitleHeight + 120);
  68.     RgnPts[6] := Point(Width - 5, TitleHeight + 180);
  69.     RgnPts[7] := Point(Width - 5, TitleHeight + 240);
  70.     RgnPts[8] := Point(Width, TitleHeight + 240);
  71.     RgnPts[9] := Point(Width, (TitleHeight * 2) + 240);
  72.     RgnPts[10] := Point(0, (TitleHeight * 2) + 240);
  73.     RgnPts[11] := Point(0, TitleHeight + 240);
  74.     RgnPts[12] := Point(5, TitleHeight + 240);
  75.     RgnPts[13] := Point(5, TitleHeight + 180);
  76.     RgnPts[14] := Point(60, TitleHeight + 120);
  77.     RgnPts[15] := Point(5, TitleHeight + 60);
  78.     RgnPts[16] := Point(5, TitleHeight);
  79.     RgnPts[17] := Point(0, TitleHeight);
  80.  
  81.     { Window Outline region }
  82.     ScnPts[0] := Point(-2, 1);
  83.     ScnPts[1] := Point(Width-4, 1);
  84.     ScnPts[2] := Point(Width - 9, 1);
  85.     ScnPts[3] := Point(Width - 9, 61);
  86.     ScnPts[4] := Point(Width - 64, 121);
  87.     ScnPts[5] := Point(Width - 9, 181);
  88.     ScnPts[6] := Point(Width - 9, 242);
  89.     ScnPts[7] := Point(Width-4, 242);
  90.     ScnPts[8] := Point(-2, 242);
  91.     ScnPts[9] := Point(3, 242);
  92.     ScnPts[10] := Point(3, 181);
  93.     ScnPts[11] := Point(58, 121);
  94.     ScnPts[12] := Point(3, 61);
  95.     ScnPts[13] := Point(3, 1);
  96.  
  97. end;
  98.  
  99.  
  100. procedure TfrmHourGlass.FormCreate(Sender: TObject);
  101. var
  102.     Region: hRgn;
  103. begin
  104.     CalcRgnPoints;        //Construct polygon
  105.     { Create region, or window boundaries from the polygon }
  106.     Region := CreatePolygonRgn(RgnPts[0], nPts, ALTERNATE);
  107.     { Assign the region to the window }
  108.     SetWindowRgn(Handle, Region, True);
  109.  
  110.     { Do not delete region - Windows now has control
  111.         of the region. }
  112. end;
  113.  
  114. procedure TfrmHourGlass.FormKeyDown(Sender: TObject; var Key: Word;
  115.     Shift: TShiftState);
  116. begin
  117.     if key = VK_Escape then Close;
  118. end;
  119.  
  120. procedure TfrmHourGlass.FormMouseDown(Sender: TObject;
  121.     Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  122. begin
  123.     if button = mbRight then
  124.         { Assign the region NULL to the window }
  125.         { to restore it's rectangular shape. }
  126.         SetWindowRgn(Handle, 0, True);
  127. end;
  128.  
  129. procedure TfrmHourGlass.FormPaint(Sender: TObject);
  130. begin
  131.     with canvas do
  132.     begin
  133.         { paint base of hourglass to match caption bar }
  134.         brush.color := clActiveCaption;
  135.         brush.Style := bsSolid;
  136.         Pen.Color := clActiveCaption;
  137.         Rectangle(0, ClientHeight - GetSystemMetrics(SM_CYCAPTION),
  138.             ClientWidth, ClientHeight);
  139.  
  140.         { Paint window border }
  141.         Brush.Color := clYellow;
  142.         Pen.Color := clActiveBorder;
  143.         Pen.Width := 2;
  144.         Polygon(Slice(ScnPts, nPts-4));
  145.     end;
  146.  
  147. end;
  148.  
  149. end.
  150.